perm filename PAGEIF[RUT,LSP] blob sn#267600 filedate 1977-03-05 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DEFPROP PAGEIFY
C00005 ENDMK
CāŠ—;
(DEFPROP PAGEIFY
 (LAMBDA (L)
  (PROG (DEV)
	(SETQ DEV (QUOTE DSK:))
   LOOP	(COND ((NULL L) (RETURN NIL)))
	(COND ((%DEVP (CAR L)) (SETQ DEV (CAR L)) (SETQ L (CDR L))))
	(PAGEFILE (LIST DEV (CAR L))
		  (LIST	(QUOTE DSK:)
			(CONS (COND ((ATOM (CAR L)) (CAR L))
				    (T (CAAR L)))
			      (QUOTE PAG))))
	(SETQ L (CDR L))
	(GO LOOP)))
 FEXPR)

(DE PAGEFILE (INFILE OUTFILE)
    (PROG (LINCNT)
	  (INC (EVAL (CONS (QUOTE INPUT) (CONS (GENSYM) INFILE))))
	  (OUTC (EVAL (CONS (QUOTE OUTPUT) (CONS (GENSYM) OUTFILE))))
	  (LINELENGTH)
	  (SETQ LINCNT 1)
	  (PAGEREADS)
	  (INC NIL T)
	  (OUTC NIL T)
	  (RETURN NIL)))

(DE PAGEREADS NIL
 (PROG (CH)
  LOOP (SETQ CH (ERRSET (READCH)))
       (COND ((ATOM CH) (RETURN NIL)))
       (SETQ CH (CAR CH))
       (COND ((EQUAL CH (QUOTE !)) (PRINC *FF)) (T (PRINC CH)))
       (GO LOOP)))

(MAPCAR	(FUNCTION (LAMBDA (PAIR)
			  (PROG2 (SET (CAR PAIR) (INTERN (ASCII (CADR PAIR))))
				 (CAR PAIR))))
	(QUOTE ((*SP 40) (*TB 11)
			 (*CR 15)
			 (*LF 12)
			 (*VT 13)
			 (*FF 14)
			 (*CO 54)
			 (*PT 56)
			 (*LP 50)
			 (*RP 51)
			 (*SL 57)
			 (*AM 33)
			 (*AT 100)
			 (*RO 177)
			 (*COLON 72)
			 (*LB 133)
			 (*RB 135))))